VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmTexto2 
   Caption         =   "Form1"
   ClientHeight    =   3570
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4920
   Icon            =   "frmEdita2.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3570
   ScaleWidth      =   4920
   Begin MSComctlLib.StatusBar stbFrmTexto2 
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   3315
      Width           =   4920
      _ExtentX        =   8678
      _ExtentY        =   450
      Style           =   1
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin VB.PictureBox picBox 
      BackColor       =   &H8000000C&
      Height          =   2295
      Left            =   0
      ScaleHeight     =   2235
      ScaleWidth      =   3555
      TabIndex        =   1
      Top             =   0
      Width           =   3615
      Begin RichTextLib.RichTextBox rtfTexto 
         Height          =   1500
         Left            =   501
         TabIndex        =   3
         Top             =   1
         Width           =   1875
         _ExtentX        =   3307
         _ExtentY        =   2646
         _Version        =   393217
         BorderStyle     =   0
         ScrollBars      =   3
         Appearance      =   0
         TextRTF         =   $"frmEdita2.frx":000C
      End
      Begin VB.PictureBox picLinhas 
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000018&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   1500
         Left            =   1
         ScaleHeight     =   107.527
         ScaleMode       =   0  'User
         ScaleWidth      =   89.189
         TabIndex        =   2
         Top             =   1
         Width           =   500
      End
   End
   Begin VB.Label lblTipo 
      Caption         =   "txt"
      Height          =   255
      Left            =   2400
      TabIndex        =   5
      Top             =   2640
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.Label lblStatus 
      Caption         =   "0"
      Height          =   195
      Left            =   1995
      TabIndex        =   4
      Top             =   2640
      Visible         =   0   'False
      Width           =   195
   End
End
Attribute VB_Name = "frmTexto2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function SendMessageLong Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function SendMessageByRef Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageByLong Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Sub Form_Load()
    ' Subclass the rtb so we can scroll the line numbers
    lPrevWndProc = SetWindowLong(rtfTexto.hWnd, GWL_WNDPROC, AddressOf WindowProc)
    setcolors
    DrawLines picLinhas
    stbFrmTexto2.SimpleText = "teste"
End Sub

Private Sub Form_Resize()
    ' Resize the textbox to the correct size
    picBox.Width = Me.ScaleWidth
    picBox.Width = 100000
    picBox.Height = Me.ScaleHeight - stbFrmTexto2.Height
    rtfTexto.Width = picBox.ScaleWidth - 480
    rtfTexto.Height = picBox.ScaleHeight
    picLinhas.Height = picBox.ScaleHeight
    
    ' Refresh the line numbers
    DrawLines picLinhas
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' This kills the subclass so we don't screw up someone's machine
    Call SetWindowLong(rtfTexto.hWnd, GWL_WNDPROC, lPrevWndProc)
    
End Sub

' Gets the number of lines in a text box and gets ready for the line numbering
' These are standard api calls
Public Function LineCount() As Long
    LineCount = SendMessageByRef(rtfTexto.hWnd, EM_GETLINECOUNT, 0&, 0&)
End Function

Public Function LineForCharacterIndex(lIndex As Long) As Long
   LineForCharacterIndex = SendMessageByLong(rtfTexto.hWnd, EM_LINEFROMCHAR, lIndex, 0)
End Function

Public Function FirstVisibleLine() As Long
   FirstVisibleLine = SendMessageByLong(rtfTexto.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0)
End Function
' This actually draws the line numbers created by the guys at vbaccelerator. Visit them at
' http://www.vbaccelerator.com. If you use this make sure to give them credit

Private Sub rtfTexto_KeyPress(KeyAscii As Integer)
    lblStatus.Caption = "1"
    'Me.Icon = App.Path & "/FILE1.BMP"
End Sub
' These make sure the line numbers are updated correctly as the user moves around
Private Sub rtfTexto_KeyUp(keycode As Integer, Shift As Integer)
    setcolors
    DrawLines picLinhas
    picLinhas.AutoRedraw = True
End Sub

Private Sub rtfTexto_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    setcolors
    DrawLines picLinhas
End Sub

Private Sub rtfTexto_SelChange()
    DrawLines picLinhas
End Sub
Private Sub rtfTexto_Change()
    DrawLines picLinhas
    'fMainForm.ActiveForm
End Sub
Private Sub rtfTexto_SetFocus()
    DrawLines picLinhas
End Sub
Public Sub setcolors()
Dim keycode As Variant
    commentchar = "'"
    longvar = "$"
    
    If keycode = 13 Then Exit Sub
    
    LockWindowUpdate Me.hWnd
    clearwordcolors rtfTexto
    ColorizeWord rtfTexto, longvar, &H80& 'This is for vars with no fixed lenght e.g (in perl _
    it could be $122434 0r $myvarx or $x ..... Always set this ($) as first word to colorize
    ColorizeWord rtfTexto, commentchar, &H8000& 'This char is for comments like this
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ColorizeWord rtfTexto, "or", &H800000
    ColorizeWord rtfTexto, "and", &H800000
    ColorizeWord rtfTexto, "random", &H800000
    ColorizeWord rtfTexto, "append", &H800000
    ColorizeWord rtfTexto, "binary", &H800000
    ColorizeWord rtfTexto, "exit", &H800000
    ColorizeWord rtfTexto, "then", &H800000
    ColorizeWord rtfTexto, "goto", &H800000
    ColorizeWord rtfTexto, "case", &H800000
    ColorizeWord rtfTexto, "select", &H800000
    ColorizeWord rtfTexto, "end", &H800000
    ColorizeWord rtfTexto, "Select Case", &H800000
    ColorizeWord rtfTexto, "End select", &H800000
    ColorizeWord rtfTexto, "for", &H800000
    ColorizeWord rtfTexto, "each", &H800000
    ColorizeWord rtfTexto, "loop", &H800000
    ColorizeWord rtfTexto, "While", &H800000
    ColorizeWord rtfTexto, "Until", &H800000
    ColorizeWord rtfTexto, "for each", &H800000
    ColorizeWord rtfTexto, "Next", &H800000
    ColorizeWord rtfTexto, "True", &H800000
    ColorizeWord rtfTexto, "False", &H800000
    ColorizeWord rtfTexto, "sub", &H800000
    ColorizeWord rtfTexto, "function", &H800000
    ColorizeWord rtfTexto, "Integer", &H800000
    ColorizeWord rtfTexto, "As", &H800000
    ColorizeWord rtfTexto, "Private", &H800000
    ColorizeWord rtfTexto, "Dim", &H800000
    ColorizeWord rtfTexto, "else", &H800000
    ColorizeWord rtfTexto, "else if", &H800000
    ColorizeWord rtfTexto, "Public", &H800000
    ColorizeWord rtfTexto, "Close", &H800000
    ColorizeWord rtfTexto, "Open", &H800000
    ColorizeWord rtfTexto, "End If", &H800000
    ColorizeWord rtfTexto, "If", &H800000
    ColorizeWord rtfTexto, "(", &H800000
    ColorizeWord rtfTexto, ")", &H800000
    
    LockWindowUpdate 0&
    rtfTexto.Enabled = True
    If rtfTexto.Visible = True Then
        rtfTexto.SetFocus
    End If
End Sub

Public Sub DrawLines(picTo As PictureBox)
Dim lLine As Long
Dim lCount As Long
Dim lCurrent As Long
Dim hBr As Long
Dim lEnd As Long
Dim lhDC As Long
Dim bComplete As Boolean
Dim tR As RECT, tTR As RECT
Dim oCol As OLE_COLOR
Dim lStart As Long
Dim lEndLine As Long
Dim tPO As POINTAPI
Dim lLineHeight As Long
Dim hPen As Long
Dim hPenOld As Long

   'Debug.Print "DrawLines"
   lhDC = picTo.hdc
   DrawText lhDC, "Hy", 2, tTR, DT_CALCRECT
   lLineHeight = tTR.Bottom - tTR.Top
   
   lCount = LineCount
   lCurrent = SendMessageLong(rtfTexto.hWnd, EM_LINEFROMCHAR, rtfTexto.SelStart, 0&)
   lStart = rtfTexto.SelStart
   lEnd = rtfTexto.SelStart + rtfTexto.SelLength - 1
   If (lEnd > lStart) Then
      lEndLine = LineForCharacterIndex(lEnd)
   Else
      lEndLine = lCurrent
   End If
   lLine = FirstVisibleLine
   GetClientRect picTo.hWnd, tR
   lEnd = tR.Bottom - tR.Top
      
   hBr = CreateSolidBrush(TranslateColor(picTo.BackColor))
   FillRect lhDC, tR, hBr
   DeleteObject hBr
   tR.Left = 2
   tR.Right = tR.Right - 2
   tR.Top = 0
   tR.Bottom = tR.Top + lLineHeight
   
   SetTextColor lhDC, TranslateColor(vbButtonShadow)
   
   Do
      ' Ensure correct colour:
      If (lLine = lCurrent) Then
         SetTextColor lhDC, TranslateColor(vbWindowText)
      ElseIf (lLine = lEndLine + 1) Then
         SetTextColor lhDC, TranslateColor(vbButtonShadow)
      End If
      ' Draw the line number:
      DrawText lhDC, CStr(lLine + 1), -1, tR, DT_RIGHT
      
      ' Increment the line:
      lLine = lLine + 1
      ' Increment the position:
      OffsetRect tR, 0, lLineHeight
      If (tR.Bottom > lEnd) Or (lLine + 1 > lCount) Then
         bComplete = True
      End If
   Loop While Not bComplete
   
   ' Draw a line...
   MoveToEx lhDC, tR.Right + 1, 0, tPO
   hPen = CreatePen(PS_SOLID, 1, TranslateColor(vbButtonShadow))
   hPenOld = SelectObject(lhDC, hPen)
   LineTo lhDC, tR.Right + 1, lEnd
   SelectObject lhDC, hPenOld
   DeleteObject hPen
   If picTo.AutoRedraw Then
      picTo.Refresh
   End If
   
End Sub


